home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / CGI shell / Pocket 6.4 / Examples / DataFiles < prev    next >
Text File  |  1992-05-07  |  2KB  |  45 lines
  1. ( DataFiles for Pocket Forth 0.6 )
  2. ( Choose and read data files )  0 28 +md !
  3. forget task : task ; decimal
  4.  
  5. : 00>R ( rstack: -- 0 0 ) ,$ 42A7 ; macro  ( clr.l -[rs] )
  6.  
  7. variable FCB 78 allot  ( our File's Control Block )
  8. : +FCB ( offset -- addr ) fcb + ;  ( offset into fcb )
  9. : 0FCB ( -- ) fcb 80 0 fill ;
  10. : FTRAP ( -- ) fcb >abs  ,$ 205E ;  ( movea.l [ps]+,a0 )
  11.  
  12. : CLOSE ( -- ) ftrap ,$ A001  ftrap ,$ A013 ;  ( close & flush )
  13. : ?DERROR ( -- ) 16 +fcb @ ?dup IF  ( if result not zero )
  14.       ." DiskError" .  close  abort THEN ;  ( report & abort )
  15.  
  16. : EOF ( -- dbytes ) ftrap ,$ A011  30 +fcb @ ;  ( _GetEOF )
  17. : !SIZE ( bytes -- ) 38 +fcb ! ;  ( set bytes-to-read or write )
  18. : !FILE ( -- ) ( set data in fcb to open file from sfreply )
  19.     0fcb  pad 6 + @  22 +fcb  !  ( set vrefnum )
  20.     pad 10 + >abs  18 +fcb  2!  ( set name )
  21.     01 27 +fcb c! ;  ( read only )
  22.  
  23. 2variable $TEXT ,s TEXT  $text 2!
  24. : OPEN ( -- ) ( select and open a file )
  25.     55 75 2>r  ( top left corner )
  26.     00>r   00>r  1 >r  $text a>r  00>r  pad a>r  ( reply at here )
  27.     2 >r  ,$ A9EA  ( _SFGetFile )
  28.     pad @ IF  ( check good field )
  29.       !file  ftrap ,$ A000  ?derror  ( _Open the file )
  30.     ELSE beep quit THEN ;
  31.  
  32. : READ ( dabs.addr -- ) ( allows read outside of dictionary )
  33.     32 +fcb 2!  ( set read buffer pointer )
  34.     ftrap ,$ A002  ?derror ;  ( _Read )
  35.  
  36. : LIST ( -- )
  37.     open  eof  dup 0< IF abs THEN  ( determine file length )
  38.     room 44 -  min  dup !size  ( set bytes to be read )
  39.     pad dup >abs read  close  swap type ;  ( read & type data )
  40.  
  41. -1 28 +md ! page
  42. ( Choose a text file from the standard get file dialog. )
  43. ( A portion of the file will be listed in this window.  )
  44. list
  45.